package STDF_Array;
use utf8;
use Moo;
use warnings;
use 5.24.0;
use feature ':5.24';
use experimental qw(lexical_subs signatures smartmatch);
use Carp qw(carp croak confess);
# use Scalar::Util qw(reftype looks_like_number);

has 'value_array'=>(
    is=>'ro',
    isa=>sub {
        confess "value_array should be a ref of array." unless ref($_[0]) eq 'ARRAY';
    },
    required=>1,
);

has 'type'=>(
    is=>'ro',
    isa=>sub {
        confess "type could only be one of (int real char)" unless $_[0] ~~ [qw(int real char nibble bit)];
    },
    required=>1
);

has 'name'=>(
    is=>'ro',
    required=>1
);

has 'sep'=>(
    is=>'rw',
    required=>0,
    default=>", "
);

has 'NA_value'=>(
    is=>'rw',
    required=>0,
    default=>'NA'
);

has 'sci_power_low_limit'=>(
    is=>'rw',
    required=>0,
    default=>-6
);

has 'sci_power_high_limit'=>(
    is=>'rw',
    required=>0,
    default=>6
);

has 'force_sci'=>(
    is=>'rw',
    required=>0,
    default=>0
);

has 'wrapper'=>(
    is=>'rw',
    isa=>sub {
        confess "wrapper should be a ref of array, contains two elements: the left and the right."
            unless ref $_[0] eq 'ARRAY';
        confess "wrapper should has and only has two elements." unless scalar @{ $_[0] }==2;
    },
    required=>0,
    default=>sub {['[',']']}
);

use overload
'""'=>sub {
    my $self=shift;
    my $format_sub=do{
        given($self->type){
            when($_ eq 'real' or ($_ eq 'int' and $self->force_sci)){
                sub {defined $_[0]?$self->format_real($_[0]):$self->NA_value };
            }
            when($_ eq 'char'){
                sub {defined $_[0]?qq{'$_[0]'}:$self->NA_value };
            }
            when($_ ~~ ['int','bit']){
                sub {defined $_[0]?int($_[0]):$self->NA_value};
            }
            when($_ eq 'nibble'){
                sub {defined $_[0]?$self->format_nibble($_[0]):$self->NA_value};
            }
            default{
                sub {$_[0] // $self->NA_value };
            }
        }
    };
    my $formatted_string='';
    if( scalar $self->value_array->@* > 0 ){
        $formatted_string = join $self->sep, map {$format_sub->($_)} @{ $self->value_array };
    }
    return $self->wrapper->[0].$formatted_string.$self->wrapper->[1];
},
'@{}'=>sub {
    my $self=shift;
    return $self->value_array;
},
'=='=>sub {
    my ($self,$y)=@_;
    if($y->isa('STDF_Array')){
        return @{$self->value_array} ~~ @{$y->value_array};
    }else{
        confess "Only two STDF_Array could be compared."
    }
}
;

sub BUILD{
    my $self=shift;
    if($self->type eq 'bit'){
        $self->{ value_array } = ([
            map {split //, unpack 'b*', pack 'C',$_} @{$self->value_array}
        ]);
    }
}

sub format_real($self, $num){
    if($self->force_sci or
        abs($num)<10**$self->sci_power_low_limit or 
        abs($num)>10**$self->sci_power_high_limit)
    {
        if( $num == 0 ){
            return '0.000';
        }
        my $pow=int(log( abs($num) )/log(10));
        my $dec=$num/(10 ** $pow);
        return sprintf "%0.3fE%i", $dec,$pow;
    }else{
        my $dec_count=$self->sci_power_high_limit;
        return sprintf "%0.${dec_count}f",$num;
    }
}

sub format_nibble($self, $num){
    my $nibble=unpack "B8",pack 'C',$num;
    my ($high,$low)=(substr($nibble,0,4),substr($nibble,4,4));
    return $self->wrapper->[0].$high.$self->sep.$low.$self->wrapper->[1];
    # return return $self->wrapper->[0]."${num}_signature".$self->wrapper->[1];
}
1;